home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / test / testprs.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  1.5 KB  |  72 lines  |  [TEXT/R*ch]
  1. datatype token =
  2.     Key of string
  3.   | Name of string
  4. ;
  5.  
  6. exception SynError of string;
  7.  
  8. fun $a (Key b :: toks) =
  9.       if a=b then (a, toks) else raise SynError a
  10.   | $a _ =
  11.       raise SynError "Symbol expected";
  12.  
  13. fun id (Name a :: toks) = (a, toks)
  14.   | id toks = raise SynError "Identifier expected";
  15.  
  16. infix 3 >>;
  17.  
  18. fun (ph >> f) toks =
  19.       let val (x, toks') = ph toks
  20.       in  (f x, toks') end;
  21.  
  22. infix 0 ||;
  23.  
  24. fun (ph1 || ph2) toks =
  25.       ph1 toks handle SynError _ => ph2 toks;
  26.  
  27. infix 5 ~~;
  28.  
  29. fun (ph1 ~~ ph2) toks =
  30.       let val (x, toks1) = ph1 toks
  31.           val (y, toks2) = ph2 toks1
  32.       in ((x,y), toks2) end;
  33.  
  34. fun empty toks = ([], toks);
  35.  
  36. fun many ph toks =
  37.       ( ph ~~ many ph >> (op ::) || empty ) toks;
  38.  
  39. fun snd (_, y) = y;
  40.  
  41. fun many_sep ph sep toks =
  42.       ( ph ~~ ( (sep ~~ many_sep ph sep >> snd) || empty ) >> (op ::) ) toks;
  43.  
  44. fun parser ph toks =
  45.       (case ph toks
  46.          of (x, [])   => x
  47.           | (_, _::_) => raise SynError "Extra characters in phrase"
  48.       );
  49.  
  50. datatype typ
  51.   = Con of string * typ list
  52.   | Var of string
  53. ;
  54.  
  55. local
  56.   fun typ toks =
  57.     (   atom ~~ $"->" ~~ typ   >> (fn ((S, _), T) => Con("->", [S,T]))
  58.     ||  atom
  59.     ) toks
  60.   and atom toks =
  61.     (   id                     >> Var
  62.     ||  $"(" ~~ typ ~~ $")"    >> (fn ((_, T), _) => T)
  63.   ) toks;
  64. in
  65.   val parseTypeExp = parser typ;
  66. end;
  67.  
  68. val t1 = [Name "a", Key "->", Name "b", Key "->", Name "c"];
  69. val t2 = [Key "(", Name "a", Key "->", Name "b", Key ")", Key "->", Name "c"];
  70. parseTypeExp t1;
  71. parseTypeExp t2;
  72.